home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 42 / Amiga Format AFCD42 (Issue 126, Aug 1999).iso / -serious- / programming / other / wild / support / metastuff_c.bas < prev    next >
BASIC Source File  |  1999-05-25  |  8KB  |  307 lines
  1. SCREEN 1,720,455,2,5
  2. WINDOW 1,"METAStuffing ...",(0,0)-(640,400),,1
  3.  
  4. '$INCLUDE BASU:_METAConsts.bas
  5. '$INCLUDE BASU:_CutWord.bas
  6. '$INCLUDE BASU:_LoadMETA.bas
  7. '$INCLUDE BASU:_Prox.bas
  8. '$INCLUDE BASU:_SafeLine.bas
  9. '$INCLUDE BASU:_METAViewTD.bas
  10. '$INCLUDE BASU:_WAITKEY.bas
  11.  
  12. CONST STUCX%=1
  13. CONST STUCY%=2
  14. CONST STUCZ%=3
  15. CONST STUR%=4
  16. CONST STUFACS%=10
  17. CONST STUMAX%=30
  18.  
  19. METAIN$="EscapeLevels:META/Tree.META"
  20. LoadMETA(METAIN$)
  21. WILDOUT$="Ram:Stuff.s"
  22. FOR i=1 TO 12
  23.  READ ObjRef(i)
  24. NEXT i
  25. viewmode&=VIEWMODE_WIRE&+VIEWFLAG_SELSHOW&
  26. CurFace=1
  27.  
  28. ST=100
  29. REPEAT cyc
  30. a$=UCASE$(WAITKEY$)
  31. SELECT CASE a$
  32.  CASE "X"
  33.   EXIT cyc
  34.  CASE "["
  35.   ObjRef(REF_O%+REF_X%)=ObjRef(REF_O%+REF_X%)-ST
  36.  CASE "]"
  37.   ObjRef(REF_O%+REF_X%)=ObjRef(REF_O%+REF_X%)+ST
  38.  CASE "-"
  39.   ObjRef(REF_O%+REF_Y%)=ObjRef(REF_O%+REF_Y%)-ST
  40.  CASE "+"
  41.   ObjRef(REF_O%+REF_Y%)=ObjRef(REF_O%+REF_Y%)+ST
  42.  CASE "*"
  43.   ObjRef(REF_O%+REF_Z%)=ObjRef(REF_O%+REF_Z%)+ST
  44.  CASE "9"
  45.   ObjRef(REF_O%+REF_Z%)=ObjRef(REF_O%+REF_Z%)-ST
  46.  CASE "2"
  47.   CALL RotRef(STA,REF_J%,REF_K%)
  48.  CASE "8"
  49.   CALL RotRef(-STA,REF_J%,REF_K%)
  50.  CASE "6"
  51.   CALL RotRef(STA,REF_I%,REF_K%)
  52.  CASE "4"
  53.   CALL RotRef(-STA,REF_I%,REF_K%)
  54.  CASE "5"
  55.   CALL RotRef(STA,REF_I%,REF_J%)
  56. END SELECT
  57. GOSUB Refresh
  58. END REPEAT cyc
  59. GOSUB stuffing
  60. END
  61. Refresh:
  62. CALL METAViewTD
  63. CLS
  64. CALL METARedrawTD(1,1,WINDOW(2),WINDOW(3),viewmode&)
  65. RETURN
  66.  
  67.  
  68. DATA 0,0,1000
  69. DATA 1,0,0
  70. DATA 0,1,0
  71. DATA 0,0,1
  72.  
  73. Stuffing:
  74. DIM Stuff(500,STUMAX%),Usf(10)
  75.  
  76. MAXD&=0:BESTA=0:BESTB=0
  77. FOR i=1 TO NDOT-1
  78.  FOR j=i+1 TO NDOT
  79.   D&=(Dot(i,DOTX%)-Dot(j,DOTX%))^2+(Dot(i,DOTY%)-Dot(j,DOTY%))^2+(Dot(i,DOTZ%)-Dot(j,DOTZ%))^2
  80.   IF D&>MAXD& THEN MAXD&=D&:BESTA=i:BESTB=j
  81.  NEXT j
  82. NEXT i
  83.  
  84. BigSCX=(Dot(BESTA,DOTX%)+Dot(BESTB,DOTX%))/2
  85. BigSCY=(Dot(BESTA,DOTY%)+Dot(BESTB,DOTY%))/2
  86. BigSCZ=(Dot(BESTA,DOTZ%)+Dot(BESTB,DOTZ%))/2
  87. BigSR=MAXD&^.5
  88.  
  89. SUB DrawX(x,y,r,c)
  90.  LINE (x-r,y-r)-(x+r,y+r),c
  91.  LINE (x-r,y+r)-(x+r,y-r),c
  92. END SUB
  93.  
  94. FUNCTION METADistancePointFace(f,x,y,z)
  95.  SHARED Face(),Dot(),hx,hy
  96.  Cx=Dot(Face(f,FACPC%),DOTX%)
  97.  Cy=Dot(Face(f,FACPC%),DOTY%)
  98.  Cz=Dot(Face(f,FACPC%),DOTZ%)
  99.  YOSC=Dot(Face(f,FACPC%),DOTYOS%)
  100.  XOSC=Dot(Face(f,FACPC%),DOTXOS%)
  101.  CALL DrawX(XOSC+hx,YOSC+hy,5,3)
  102.  Ax=Dot(Face(f,FACPA%),DOTX%)-Cx
  103.  Ay=Dot(Face(f,FACPA%),DOTY%)-Cy
  104.  Az=Dot(Face(f,FACPA%),DOTZ%)-Cz
  105.  Bx=Dot(Face(f,FACPB%),DOTX%)-Cx
  106.  By=Dot(Face(f,FACPB%),DOTY%)-Cy
  107.  Bz=Dot(Face(f,FACPB%),DOTZ%)-Cz
  108.  xr=x-Cx
  109.  yr=y-Cy
  110.  zr=z-Cz
  111.  Ik=Bz*Ay-Az*By
  112.  Jk=Az*Bx-Bz*Ax
  113.  Kk=By*Ax-Bx*Ay
  114.  Lk=(Ik^2+Jk^2+Kk^2)^.5
  115.  PS=Ik*xr+Jk*yr+Kk*zr
  116.  d=PS/Lk
  117.  METADistancePointFace=d
  118. END FUNCTION
  119.  
  120. SUB SphereDraw(x,y,z,r)
  121.  SHARED hx,hy,ObjRef()
  122.  mx=x*ObjRef(REF_I%+REF_X%)+y*ObjRef(REF_J%+REF_X%)+z*ObjRef(REF_K%+REF_X%)+ObjRef(REF_O%+REF_X%)
  123.  my=x*ObjRef(REF_I%+REF_Y%)+y*ObjRef(REF_J%+REF_Y%)+z*ObjRef(REF_K%+REF_Y%)+ObjRef(REF_O%+REF_Y%)
  124.  mz=x*ObjRef(REF_I%+REF_Z%)+y*ObjRef(REF_J%+REF_Z%)+z*ObjRef(REF_K%+REF_Z%)+ObjRef(REF_O%+REF_Z%)
  125.  xos=ProX(mx,mz)+hx
  126.  yos=ProY(my,mz)+hy
  127.  ros=ABS((ABS(r)*256)/(mz+256))
  128. ' PRINT "ros ",ros,xos,yos
  129.  CIRCLE (xos,yos),ros,3,,,1
  130. END SUB
  131.  
  132. ' Condizioni per ogni sfera:
  133. ' essere tangente a tre facce almeno, che determinano quasi tutto.
  134. ' poi, trovate le coordinate del centro in funzione del raggio, provare con tutte
  135. ' le altre facce il raggio massimo.
  136. ' novo metodo, più lento probabilmente ma chi se ne frega. 
  137. ' E' lo stesso, solo che faccio un sistema 4x4 per ogni 4 facce, di cui 3 sono
  138. ' le tangenti fisse, la quarta è un ciclo, per trovare il raggio maggiore possibile.
  139. '
  140. ' kax*(cx-oax)+kay*(cy-oay)+kaz*(cz-oaz)=r
  141. ' quindi
  142. ' kax*cx+kay*cy+kaz*cz-r=oax*kax+oay*kay+oaz*kaz !!! (bene! è costante !)
  143. ' matrice:
  144. ' |kax kay kaz -1|     |ma|     (ma=oax*kax+oay*...)
  145. ' |kbx kby kbz -1|     |mb|
  146. ' |kcx kcy kcz -1|     |mc|
  147. ' |kfx kfy kfz -1|     |mf|    (f=faccia ciclata)
  148.  
  149. COLOR 1,0
  150. NSTU=0
  151. MINR=20
  152. 'FOR i=1 TO NDOT
  153.  GOSUB Refresh
  154.  NUSF=0
  155.  FOR j=1 TO NFAC
  156.   IF Face(j,FACPA%)=i OR Face(j,FACPB%)=i OR Face(j,FACPC%)=i THEN NUSF=NUSF+1:Usf(NUSF)=j
  157.  NEXT j
  158.  IF NUSF>=3
  159.   fa=Usf(1)
  160.   fb=Usf(2)
  161.   fc=Usf(3)
  162.  
  163.   PRINT "Faces: ",fa;fb;fc
  164.   
  165.   axc=Dot(Face(fa,FACPC%),DOTX%)
  166.   ayc=Dot(Face(fa,FACPC%),DOTY%)
  167.   azc=Dot(Face(fa,FACPC%),DOTZ%)
  168.   axa=Dot(Face(fa,FACPA%),DOTX%)-axc
  169.   aya=Dot(Face(fa,FACPA%),DOTY%)-ayc
  170.   aza=Dot(Face(fa,FACPA%),DOTZ%)-azc
  171.   axb=Dot(Face(fa,FACPB%),DOTX%)-axc
  172.   ayb=Dot(Face(fa,FACPB%),DOTY%)-ayc
  173.   azb=Dot(Face(fa,FACPB%),DOTZ%)-azc
  174.   kax=azb*aya-aza*ayb
  175.   kay=aza*axb-azb*axa
  176.   kaz=axa*ayb-aya*axb
  177.   lka=(kax^2+kay^2+kaz^2)^.5
  178.   kax=kax/lka
  179.   kay=kay/lka
  180.   kaz=kaz/lka
  181.   bxc=Dot(Face(fb,FACPC%),DOTX%)
  182.   byc=Dot(Face(fb,FACPC%),DOTY%)
  183.   bzc=Dot(Face(fb,FACPC%),DOTZ%)
  184.   bxa=Dot(Face(fb,FACPA%),DOTX%)-bxc
  185.   bya=Dot(Face(fb,FACPA%),DOTY%)-byc
  186.   bza=Dot(Face(fb,FACPA%),DOTZ%)-bzc
  187.   bxb=Dot(Face(fb,FACPB%),DOTX%)-bxc
  188.   byb=Dot(Face(fb,FACPB%),DOTY%)-byc
  189.   bzb=Dot(Face(fb,FACPB%),DOTZ%)-bzc
  190.   kbx=bzb*bya-bza*byb
  191.   kby=bza*bxb-bzb*bxa
  192.   kbz=bxa*byb-bya*bxb
  193.   lkb=(kbx^2+kby^2+kbz^2)^.5
  194.   kbx=kbx/lkb
  195.   kby=kby/lkb
  196.   kbz=kbz/lkb
  197.   cxc=Dot(Face(fc,FACPC%),DOTX%)
  198.   cycy=Dot(Face(fc,FACPC%),DOTY%)
  199.   czc=Dot(Face(fc,FACPC%),DOTZ%)
  200.   cxa=Dot(Face(fc,FACPA%),DOTX%)-cxc
  201.   cya=Dot(Face(fc,FACPA%),DOTY%)-cycy
  202.   cza=Dot(Face(fc,FACPA%),DOTZ%)-czc
  203.   cxb=Dot(Face(fc,FACPB%),DOTX%)-cxc
  204.   cyb=Dot(Face(fc,FACPB%),DOTY%)-cycy
  205.   czb=Dot(Face(fc,FACPB%),DOTZ%)-czc
  206.   kcx=czb*cya-cza*cyb
  207.   kcy=cza*cxb-czb*cxa
  208.   kcz=cxa*cyb-cya*cxb
  209.   lkc=(kcx^2+kcy^2+kcz^2)^.5
  210.   kcx=kcx/lkc
  211.   kcy=kcy/lkc
  212.   kcz=kcz/lkc                ' fin qui penso sia tutto OK.
  213.                       ' coi vettori normalizzati (lk=1) è meglio.
  214.   PRINT "ka ",kax,kay,kaz
  215.   PRINT "kb ",kbx,kby,kbz
  216.   PRINT "kc ",kcx,kcy,kcz
  217.  
  218.   PRINT "oa ",axc,ayc,azc
  219.   PRINT "ob ",bxc,byc,bzc
  220.   PRINT "oc ",cxc,cycy,czc
  221.  
  222.   ma=axc*kax+ayc*kay+azc*kaz
  223.   mb=bxc*kbx+byc*kby+bzc*kbz
  224.   mc=cxc*kcx+cycy*kcy+czc*kcz
  225.  
  226.   f=4
  227.   fxc=Dot(Face(f,FACPC%),DOTX%)
  228.   fyc=Dot(Face(f,FACPC%),DOTY%)
  229.   fzc=Dot(Face(f,FACPC%),DOTZ%)
  230.   fxa=Dot(Face(f,FACPA%),DOTX%)-fxc
  231.   fya=Dot(Face(f,FACPA%),DOTY%)-fyc
  232.   fza=Dot(Face(f,FACPA%),DOTZ%)-fzc
  233.   fxb=Dot(Face(f,FACPB%),DOTX%)-fxc
  234.   fyb=Dot(Face(f,FACPB%),DOTY%)-fyc
  235.   fzb=Dot(Face(f,FACPB%),DOTZ%)-fzc
  236.   kfx=fzb*fya-fza*fyb
  237.   kfy=fza*fxb-fzb*fxa
  238.   kfz=fxa*fyb-fya*fxb
  239.   lkf=(kfx^2+kfy^2+kfz^2)^.5
  240.   kfx=kfx/lkf
  241.   kfy=kfy/lkf
  242.   kfz=kfz/lkf
  243.   
  244.   mf=fxc*kfx+fyc*kfy+fzc*kfz
  245.  
  246. ' kax*(cx-oax)+kay*(cy-oay)+kaz*(cz-oaz)=r
  247. ' kax*cx+kay*cy+kaz*cz-r=oax*kax+oay*kay+oaz*kaz !!! (bene! è costante !)
  248. ' matrice:
  249. ' |kax kay kaz -1|     |ma|     (ma=oax*kax+oay*...)
  250. ' |kbx kby kbz -1|     |mb|
  251. ' |kcx kcy kcz -1|     |mc|
  252. ' |kfx kfy kfz -1|     |mf|    (f=faccia ciclata)
  253.  
  254.  det4=-(kax*kby*kcz+kay*kbz*kcx+kaz*kbx*kcy-kaz*kby*kcx-kay*kbx*kcz-kax*kbz*kcy)
  255.  det3=(kax*kby*kfz+kay*kbz*kfx+kaz*kbx*kfy-kaz*kby*kfx-kay*kbx*kfz-kax*kbz*kfy)
  256.  det2=-(kax*kcy*kfz+kay*kcz*kfx+kaz*kcx*kfy-kaz*kcy*kfx-kay*kcx*kfz-kax*kcz*kfy)
  257.  det1=(kbx*kcy*kaz+kby*kcz*kfx+kbz*kcx*kfy-kbz*kcy*kfx-kby*kcx*kfz-kbx*kcz*kfy)
  258.  det=det1+det2+det3+det4
  259.  
  260.  detx4=-(ma*kby*kcz+kay*kbz*mc+kaz*mb*kcy-kaz*kby*mc-kay*mb*kcz-ma*kbz*kcy)
  261.  detx3=(ma*kby*kfz+kay*kbz*mf+kaz*mb*kfy-kaz*kby*mf-kay*mb*kfz-ma*kbz*kfy)
  262.  detx2=-(ma*kcy*kfz+kay*kcz*mf+kaz*mc*kfy-kaz*kcy*mf-kay*mc*kfz-ma*kcz*kfy)
  263.  detx1=(mb*kcy*kaz+kby*kcz*mf+kbz*mc*kfy-kbz*kcy*mf-kby*mc*kfz-mb*kcz*kfy)
  264.  detx=detx1+detx2+detx3+detx4
  265.  
  266.  dety4=-(kax*mb*kcz+ma*kbz*kcx+kaz*kbx*mc-kaz*mb*kcx-ma*kbx*kcz-kax*kbz*mc)
  267.  dety3=(kax*mb*kfz+ma*kbz*kfx+kaz*kbx*mf-kaz*mb*kfx-ma*kbx*kfz-kax*kbz*mf)
  268.  dety2=-(kax*mc*kfz+ma*kcz*kfx+kaz*kcx*mf-kaz*mc*kfx-ma*kcx*kfz-kax*kcz*mf)
  269.  dety1=(kbx*mc*kaz+mb*kcz*kfx+kbz*kcx*mf-kbz*mc*kfx-mb*kcx*kfz-kbx*kcz*mf)
  270.  dety=dety1+dety2+dety3+dety4
  271.  
  272.  detz4=-(kax*kby*mb+kay*mb*kcx+ma*kbx*kcy-ma*kby*kcx-kay*kbx*mb-kax*mb*kcy)
  273.  detz3=(kax*kby*mf+kay*mb*kfx+ma*kbx*kfy-ma*kby*kfx-kay*kbx*mf-kax*mb*kfy)
  274.  detz2=-(kax*kcy*mf+kay*mb*kfx+ma*kcx*kfy-ma*kcy*kfx-kay*kcx*mf-kax*mb*kfy)
  275.  detz1=(kbx*kcy*ma+kby*mb*kfx+mb*kcx*kfy-mb*kcy*kfx-kby*kcx*mf-kbx*mb*kfy)
  276.  detz=detz1+detz2+detz3+detz4
  277.  
  278.  detr4=-ma*det4
  279.  detr3=-mb*det3
  280.  detr2=-mc*det2
  281.  detr1=-mf*det1
  282.  detr=detr1+detr2+detr3+detr4
  283.  
  284.  PRINT "ma,b,c,f",ma,mb,mc,mf
  285.  PRINT "d tot,x,y,z,r",det,detx,dety,detz,detr
  286.  
  287.  cxf=detx/det
  288.  cyf=dety/det
  289.  czf=detz/det
  290.  r=detr/det  
  291.  PRINT "r,x,y,z",r,cxf,cyf,czf
  292.  CALL SphereDraw(cxf,cyf,czf,r)
  293.  
  294.  PRINT "dfa ",METADistancePointFace(fa,cxf,cyf,czf)
  295.  PRINT "dfb ",METADistancePointFace(fb,cxf,cyf,czf)
  296.  PRINT "dfc ",METADista